home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / game / role / DSA_Utils.lha / DSA-Utils / DSA_Wetter.p < prev    next >
Text File  |  1997-09-21  |  7KB  |  190 lines
  1. { ex: ts=2 ai
  2. }
  3. program DSA_Wetter;
  4.     { Generiert Wetter-Tabelle nach DSA-Regeln }
  5.     { Quelle: "Das Handbuch für den Reisenden" }
  6.     { © copyright 1995-97 by Henning Peters }
  7.     { eMail: faroul@beyond.hb.north.de }
  8.     { Public-Domain - darf zwecks Systemanpassung }
  9.     { modifiziert werden; dann bitte Source an mich senden. }
  10.  
  11. {$I "include:utils/StringLib.i"}
  12. {$I "include:utils/Random.i"}
  13.  
  14. const
  15.     Version="2.1";
  16.     c_Wind:array[0..8]of string=
  17.                 ("windstill\\\\","leichter Windzug\\\\","leichte Brise\\\\",
  18.                  "frische Brise\\\\","steife Brise\\\\","starker Wind\\\\","Sturm\\\\",
  19.                  "schwerer Sturm\\\\","Orkan\\\\");
  20.     c_Temp:array[0..8]of string=
  21.                 (" & empfindlich kalt & "," & kalt & "," & k\\\"uhl & ",
  22.                  " & der Jahreszeit entsprechend & "," & der Jahreszeit entsprechend & ",
  23.                  " & der Jahreszeit entsprechend & "," & warm & ",
  24.                  " & sehr warm & "," & f\\\"ur die Jahreszeit unnat\\\"urlich warm & ");
  25.     c_vWetter:array[1..4,1..20]of short=
  26.                 ((0,0,0,0,0,0,-3,-3,-1,-1,-1,-1,-2,-2,-2,-2,-2,-4,-4,2),
  27.                  (-2,-2,-2,-2,-2,-2,-2,-2,-2,-2,-1,-1,-1,-1,-1,-4,-3,1,5,5),
  28.                  (0,0,0,0,0,0,-3,-3,-1,-1,-1,-1,-2,-2,-2,-2,-2,-4,-4,2),
  29.                  (-1,-1,-1,-1,-1,-1,-2,-2,-2,-2,-2,-2,-3,-3,-4,-4,-2,-2,-2,-2));
  30.     c_vWind:array[1..4,1..20]of short=
  31.                 ((0,0,0,0,0,0,1,1,-1,-1,-1,-1,-3,-3,-3,-1,-1,2,2,4),
  32.                  (-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-2,-2,-2,-2,-2,1,1,2,4,4),
  33.                  (0,0,0,0,0,0,1,1,-1,-1,-1,-1,-3,-3,-3,-1,-1,2,2,4),
  34.                  (0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2));
  35.     c_vTemp:array[1..4,1..20]of short=
  36.                 ((0,0,0,0,0,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-2,-2,-3),
  37.                  (1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,0,0,-1,-2,-2),
  38.                  (0,0,0,0,0,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-2,-2,-3),
  39.                  (-2,-2,-2,-2,-2,-2,-1,-1,-1,-1,-1,-1,1,1,2,2,0,0,0,0));
  40.  
  41. var
  42.     Breite,Zeit,Tage,Wetter,Wind,Temp:short;
  43.     Ausfile:text;
  44.     c:char;
  45.     Tag:integer;
  46.     Jz,str:string;
  47.     Unwetter:boolean;
  48.  
  49.  
  50. { Strings sind wie in C, also Pointer! }
  51. function int_str(i:integer):string;    { i=0..999 }
  52. var str:string;
  53. begin str:=AllocString(5);
  54.     if i<10 then begin
  55.         str[0]:=chr(i+48); str[1]:='\0'
  56.     end else if i<100 then begin
  57.         str[0]:=chr(i div 10+48); str[1]:=chr(i mod 10+48); str[2]:='\0'
  58.         end else begin
  59.                 str[0]:=chr(i div 100+48); str[1]:=chr((i mod 100)div 10+48);
  60.                 str[2]:=chr(i mod 10+48); str[3]:='\0'
  61.         end;
  62.     int_str:=str
  63. end;
  64.  
  65. function str_int(str:string):short;
  66. var i,j:integer;
  67.         l,n:short;
  68. begin
  69.     i:=0; l:=pred(strlen(str));
  70.     for j:=0 to l do begin
  71.         n:=ord(str[j])-48;
  72.         if (n<0) or (n>9) then str_int:=0;
  73.         i:=i*10+n
  74.     end;
  75.     str_int:=i
  76. end;
  77.  
  78. function Wurf(w:byte):short;
  79. begin
  80.     Wurf:=succ(RangeRandom(pred(w)))
  81. end;    { RangeRandom(n) liefert 0..n; für 1..6 also (0..(6-1))+1 }
  82.  
  83. function Range(a:short):short;
  84. begin
  85.     if a<0 then Range:=0 else if a>8 then Range:=8;
  86.     Range:=a;    { Bei mir: Func:=Wert -> Exit Func }
  87. end;
  88.  
  89. function Near(a:short):short;
  90. var b,c:short;
  91. begin
  92.     b:=Wurf(6); c:=Wurf(6);
  93.     if abs(a-b)>abs(a-c) then Near:=c else Near:=b
  94. end;
  95.  
  96. procedure Ausgabe;
  97. var s,aus:string;
  98.     p:short;
  99.     l,j:integer;
  100. begin
  101.     case Zeit of
  102.         1,3: case Wetter of
  103.             1..6:    s:="Klar";
  104.             7,8:     s:="Bew\\\"olkt, gelegentlich Schauer";
  105.             9..12: s:="Leichter Morgennebel, dann aufklarend";
  106.             13..15:s:="Nebel";
  107.             16,17: s:="Nieselregen";
  108.             18,19: s:="Dauerregen";
  109.             20:        s:="Gewitter, Wolkenbruch (";
  110.         end;
  111.         2: case Wetter of
  112.             1..10: s:="Sonnig und klar";
  113.             11..15:s:="Schw\\\"ulwarm, dunstig";
  114.             16:        s:="Kurze Schauer";
  115.             17:        s:="Nieselregen";
  116.             18:        s:="Gewitter, heftige Schauer";
  117.             19,20: s:="Gewitter, Wolkenbruch (";
  118.         end;
  119.         4: case Wetter of
  120.             1..6:    s:="Frostklar";
  121.             7..12: s:="Klar";
  122.             13,14: s:="einzelne Flocken";
  123.             15,16: s:="Schneeschauer";
  124.             17..20:s:="Starker Schneefall"
  125.         end
  126.     end;
  127.     aus:=AllocString(200);
  128.     if Unwetter then begin
  129.         strcpy(aus," & Anschlie\\ss end: "); Unwetter:=false
  130.     end else begin
  131.         strcpy(aus,int_str(Tag)); strcat(aus," & ");
  132.     end;
  133.     strcat(aus,s);
  134.     if ((Zeit=2) and (Wetter>18)) or (((Zeit=1) or (Zeit=3)) and (Wetter=20)) then begin
  135.         p:=Wurf(3); strcat(aus,int_str(p));
  136.         if p>1 then strcat(aus," Stunden)") else strcat(aus," Stunde)");
  137.         Unwetter:=true; dec(Tag);
  138.     end;
  139.     strcat(aus,c_Temp[Temp]); strcat(aus,c_Wind[Wind]);
  140.     if not Unwetter then strcat(aus,"\\hline\n");
  141.     write(Ausfile,aus)
  142. end;
  143.  
  144.  
  145. begin                { Main }
  146.     write("\f\n        \e[1mDSA Wettergenerator\e[0m V",Version,"\n\n    © copyright 1995-97 by Henning Peters\n  eMail: faroul@beyond.hb.no\/rth.d\n\nFür wieviel Tage soll das Wetter berechnet werden (45 pro Seite)? ");
  147.     { \e=Esc=chr(27); \f=chr(12)=ClearScreen; \e[1m=BoldOn, \e[0m=BoldOff }
  148.     str:=AllocString(60);
  149.     readln(str); Tage:=str_int(str); if Tage<1 then exit(5);
  150.     repeat
  151.         write("\nWelche Jahreszeit soll genommen werden:\n    \e[4mF\e[0mrühjahr, \e[4mS\e[0mommer, \e[4mH\e[0merbst oder \e[4mW\e[0minter? ");
  152.         readln(c);
  153.         case tolower(c) of
  154.             'f':begin Zeit:=1; Jz:="Fr\\\"uhjahr" end;
  155.             's':begin Zeit:=2; Jz:="Sommer" end;
  156.             'h':begin Zeit:=3; Jz:="Herbst" end;
  157.             'w':begin Zeit:=4; Jz:="Winter" end
  158.             else begin Zeit:=0; write("Das geht nicht!\eM\eM\eM") end
  159.         end;
  160.     until Zeit>0;    { \e=Esc=chr(27); \eM=Cursor up }
  161.     selfseed;    { Zufallsgenerator starten }
  162.     Wetter:=wurf(20); Wind:=Range(Wurf(6)+c_vWind[Zeit,Wetter]);
  163.     Temp:=Range(Wurf(6)+c_vTemp[Zeit,Wetter]);
  164.     repeat
  165.         write("\nName der Ausgabedatei (ohne Endung `.tex'): "); readln(str);
  166.         strcat(str,".tex"); c:='j';
  167.         if reopen(str,Ausfile) then begin
  168.             write("\n\aAchtung! Datei `",str,"' existiert bereits! Überschreiben (j/n)? ");
  169.             readln(c); close(Ausfile)
  170.         end
  171.     until tolower(c)='j';
  172.     if open(str,Ausfile,1024) then begin
  173.         write("\nGeneriere Wetterdaten");
  174.         write(Ausfile,"\\documentstyle{article}\n\\topmargin 0pt \\voffset -2cm \\hoffset -1cm \\textwidth 512pt \\textheight 25cm\n\\oddsidemargin 0mm \\evensidemargin 0mm \\marginparwidth 0mm \\marginparsep 0mm\n\\begin{document}\n\\begin{center}\n{\\Large\\bf ",Jz,"}\\\\[2mm]\n\\begin{tabular}{|r|l|l|l|}\n\\hline\n\\bf Tag & \\bf Wetter \\bf & \\bf Temperatur & \\bf Wind\\\\ \\hline\n");
  175.         for Tag:=1 to Tage do begin
  176.             Ausgabe; if Tag mod 10=0 then write('.');
  177.             Wetter:=Wetter+Wurf(6)+c_vWetter[Zeit,Wetter];
  178.             if Wetter<1 then inc(Wetter,20)
  179.             else if Wetter>20 then dec(Wetter,20);
  180.             Wind:=Range(Near(Wind)+c_vWind[Zeit,Wetter]);
  181.             Temp:=Range(Near(Temp)+c_vTemp[Zeit,Wetter]);
  182.             if (Tag mod 45=0) and (Tag<Tage) then
  183.                 write(Ausfile,"\\end{tabular}\n\\end{center}\n\\vfill{\\small\\sf DSA-Wettergenerator V",Version," -- \\copyright\ copyright 1995/96 by Henning Peters \\hfill E-Mail: faroul@beyond.hb.north.de}\n\\newpage\n\\begin{center}\n{\\Large\\bf ",Jz,"}\\\\[2mm]\n\\begin{tabular}{|r|l|l|l|}\n\\hline\n\\bf Tag & \\bf Wetter \\bf & \\bf Temperatur & \\bf Wind\\\\ \\hline\n");
  184.         end;
  185.         write(Ausfile,"\\end{tabular}\n\\end{center}\n\\vfill{\\small\\sf DSA-Wettergenerator V",Version," -- \\copyright\ copyright 1995--97 by Henning Peters \\hfill eMail: faroul@beyond.hb.north.de}\n\\end{document}\n");
  186.         close(Ausfile); write("Ok.\n\n")
  187.     end else write("\aKonnte `",str,"' nicht zum Schreiben öffnen!\n")
  188. end.    { \a=Attention=chr(7) }
  189.  
  190.